home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / GIMP 2.6.8 / gimp-2.6.8-i686-setup.exe / {app} / share / gimp / 2.0 / scripts / weave.scm < prev    next >
Text File  |  2009-12-15  |  15KB  |  412 lines
  1. ; GIMP - The GNU Image Manipulation Program
  2. ; Copyright (C) 1995 Spencer Kimball and Peter Mattis
  3. ;
  4. ; Weave script --- make an image look as if it were woven
  5. ; Copyright (C) 1997 Federico Mena Quintero
  6. ; federico@nuclecu.unam.mx
  7. ;
  8. ; This program is free software; you can redistribute it and/or modify
  9. ; it under the terms of the GNU General Public License as published by
  10. ; the Free Software Foundation; either version 2 of the License, or
  11. ; (at your option) any later version.
  12. ;
  13. ; This program is distributed in the hope that it will be useful,
  14. ; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. ; GNU General Public License for more details.
  17. ;
  18. ; You should have received a copy of the GNU General Public License
  19. ; along with this program; if not, write to the Free Software
  20. ; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22.  
  23. ; Copies the specified rectangle from/to the specified drawable
  24.  
  25. (define (copy-rectangle img
  26.                         drawable
  27.                         x1
  28.                         y1
  29.                         width
  30.                         height
  31.                         dest-x
  32.                         dest-y)
  33.   (gimp-rect-select img x1 y1 width height CHANNEL-OP-REPLACE FALSE 0)
  34.   (gimp-edit-copy drawable)
  35.   (let ((floating-sel (car (gimp-edit-paste drawable FALSE))))
  36.     (gimp-layer-set-offsets floating-sel dest-x dest-y)
  37.     (gimp-floating-sel-anchor floating-sel))
  38.   (gimp-selection-none img))
  39.  
  40. ; Creates a single weaving tile
  41.  
  42. (define (create-weave-tile ribbon-width
  43.                            ribbon-spacing
  44.                            shadow-darkness
  45.                            shadow-depth)
  46.   (let* ((tile-size (+ (* 2 ribbon-width) (* 2 ribbon-spacing)))
  47.          (darkness (* 255 (/ (- 100 shadow-darkness) 100)))
  48.          (img (car (gimp-image-new tile-size tile-size RGB)))
  49.          (drawable (car (gimp-layer-new img tile-size tile-size RGB-IMAGE
  50.                                         "Weave tile" 100 NORMAL-MODE))))
  51.     (gimp-image-undo-disable img)
  52.     (gimp-image-add-layer img drawable 0)
  53.  
  54.     (gimp-context-set-background '(0 0 0))
  55.     (gimp-edit-fill drawable BACKGROUND-FILL)
  56.  
  57.     ; Create main horizontal ribbon
  58.  
  59.     (gimp-context-set-foreground '(255 255 255))
  60.     (gimp-context-set-background (list darkness darkness darkness))
  61.  
  62.     (gimp-rect-select img
  63.                       0
  64.                       ribbon-spacing
  65.                       (+ (* 2 ribbon-spacing) ribbon-width)
  66.                       ribbon-width
  67.                       CHANNEL-OP-REPLACE
  68.                       FALSE
  69.                       0)
  70.  
  71.     (gimp-edit-blend drawable FG-BG-RGB-MODE NORMAL-MODE
  72.                      GRADIENT-BILINEAR 100 (- 100 shadow-depth) REPEAT-NONE FALSE
  73.                      FALSE 0 0 TRUE
  74.                      (/ (+ (* 2 ribbon-spacing) ribbon-width -1) 2) 0 0 0)
  75.  
  76.     ; Create main vertical ribbon
  77.  
  78.     (gimp-rect-select img
  79.                       (+ (* 2 ribbon-spacing) ribbon-width)
  80.                       0
  81.                       ribbon-width
  82.                       (+ (* 2 ribbon-spacing) ribbon-width)
  83.                       CHANNEL-OP-REPLACE
  84.                       FALSE
  85.                       0)
  86.  
  87.     (gimp-edit-blend drawable FG-BG-RGB-MODE NORMAL-MODE
  88.                      GRADIENT-BILINEAR 100 (- 100 shadow-depth) REPEAT-NONE FALSE
  89.                      FALSE 0 0 TRUE
  90.                      0 (/ (+ (* 2 ribbon-spacing) ribbon-width -1) 2) 0 0)
  91.  
  92.     ; Create the secondary horizontal ribbon
  93.  
  94.     (copy-rectangle img
  95.                     drawable
  96.                     0
  97.                     ribbon-spacing
  98.                     (+ ribbon-width ribbon-spacing)
  99.                     ribbon-width
  100.                     (+ ribbon-width ribbon-spacing)
  101.                     (+ (* 2 ribbon-spacing) ribbon-width))
  102.  
  103.     (copy-rectangle img
  104.                     drawable
  105.                     (+ ribbon-width ribbon-spacing)
  106.                     ribbon-spacing
  107.                     ribbon-spacing
  108.                     ribbon-width
  109.                     0
  110.                     (+ (* 2 ribbon-spacing) ribbon-width))
  111.  
  112.     ; Create the secondary vertical ribbon
  113.  
  114.     (copy-rectangle img
  115.                     drawable
  116.                     (+ (* 2 ribbon-spacing) ribbon-width)
  117.                     0
  118.                     ribbon-width
  119.                     (+ ribbon-width ribbon-spacing)
  120.                     ribbon-spacing
  121.                     (+ ribbon-width ribbon-spacing))
  122.  
  123.     (copy-rectangle img
  124.                     drawable
  125.                     (+ (* 2 ribbon-spacing) ribbon-width)
  126.                     (+ ribbon-width ribbon-spacing)
  127.                     ribbon-width
  128.                     ribbon-spacing
  129.                     ribbon-spacing
  130.                     0)
  131.  
  132.     ; Done
  133.  
  134.     (gimp-image-undo-enable img)
  135.  
  136.     (list img drawable)))
  137.  
  138. ; Creates a complete weaving mask
  139.  
  140. (define (create-weave width
  141.                       height
  142.                       ribbon-width
  143.                       ribbon-spacing
  144.                       shadow-darkness
  145.                       shadow-depth)
  146.   (let* ((tile (create-weave-tile ribbon-width ribbon-spacing shadow-darkness
  147.                                   shadow-depth))
  148.          (tile-img (car tile))
  149.          (tile-layer (cadr tile))
  150.           (weaving (plug-in-tile RUN-NONINTERACTIVE tile-img tile-layer width height TRUE)))
  151.     (gimp-image-delete tile-img)
  152.     weaving))
  153.  
  154. ; Creates a single tile for masking
  155.  
  156. (define (create-mask-tile ribbon-width
  157.                           ribbon-spacing
  158.                           r1-x1
  159.                           r1-y1
  160.                           r1-width
  161.                           r1-height
  162.                           r2-x1
  163.                           r2-y1
  164.                           r2-width
  165.                           r2-height
  166.                           r3-x1
  167.                           r3-y1
  168.                           r3-width
  169.                           r3-height)
  170.   (let* ((tile-size (+ (* 2 ribbon-width) (* 2 ribbon-spacing)))
  171.          (img (car (gimp-image-new tile-size tile-size RGB)))
  172.          (drawable (car (gimp-layer-new img tile-size tile-size RGB-IMAGE
  173.                                         "Mask" 100 NORMAL-MODE))))
  174.     (gimp-image-undo-disable img)
  175.     (gimp-image-add-layer img drawable 0)
  176.  
  177.     (gimp-context-set-background '(0 0 0))
  178.     (gimp-edit-fill drawable BACKGROUND-FILL)
  179.  
  180.     (gimp-rect-select img r1-x1 r1-y1 r1-width r1-height CHANNEL-OP-REPLACE FALSE 0)
  181.     (gimp-rect-select img r2-x1 r2-y1 r2-width r2-height CHANNEL-OP-ADD FALSE 0)
  182.     (gimp-rect-select img r3-x1 r3-y1 r3-width r3-height CHANNEL-OP-ADD FALSE 0)
  183.  
  184.     (gimp-context-set-background '(255 255 255))
  185.     (gimp-edit-fill drawable BACKGROUND-FILL)
  186.     (gimp-selection-none img)
  187.  
  188.     (gimp-image-undo-enable img)
  189.  
  190.     (list img drawable)))
  191.  
  192. ; Creates a complete mask image
  193.  
  194. (define (create-mask final-width
  195.                      final-height
  196.                      ribbon-width
  197.                      ribbon-spacing
  198.                      r1-x1
  199.                      r1-y1
  200.                      r1-width
  201.                      r1-height
  202.                      r2-x1
  203.                      r2-y1
  204.                      r2-width
  205.                      r2-height
  206.                      r3-x1
  207.                      r3-y1
  208.                      r3-width
  209.                      r3-height)
  210.   (let* ((tile (create-mask-tile ribbon-width ribbon-spacing
  211.                                  r1-x1 r1-y1 r1-width r1-height
  212.                                  r2-x1 r2-y1 r2-width r2-height
  213.                                  r3-x1 r3-y1 r3-width r3-height))
  214.          (tile-img (car tile))
  215.          (tile-layer (cadr tile))
  216.          (mask (plug-in-tile RUN-NONINTERACTIVE tile-img tile-layer final-width final-height
  217.                              TRUE)))
  218.     (gimp-image-delete tile-img)
  219.     mask))
  220.  
  221. ; Creates the mask for horizontal ribbons
  222.  
  223. (define (create-horizontal-mask ribbon-width
  224.                                 ribbon-spacing
  225.                                 final-width
  226.                                 final-height)
  227.   (create-mask final-width
  228.                final-height
  229.                ribbon-width
  230.                ribbon-spacing
  231.                0
  232.                ribbon-spacing
  233.                (+ (* 2 ribbon-spacing) ribbon-width)
  234.                ribbon-width
  235.                0
  236.                (+ (* 2 ribbon-spacing) ribbon-width)
  237.                ribbon-spacing
  238.                ribbon-width
  239.                (+ ribbon-width ribbon-spacing)
  240.                (+ (* 2 ribbon-spacing) ribbon-width)
  241.                (+ ribbon-width ribbon-spacing)
  242.                ribbon-width))
  243.  
  244. ; Creates the mask for vertical ribbons
  245.  
  246. (define (create-vertical-mask ribbon-width
  247.                               ribbon-spacing
  248.                               final-width
  249.                               final-height)
  250.   (create-mask final-width
  251.                final-height
  252.                ribbon-width
  253.                ribbon-spacing
  254.                (+ (* 2 ribbon-spacing) ribbon-width)
  255.                0
  256.                ribbon-width
  257.                (+ (* 2 ribbon-spacing) ribbon-width)
  258.                ribbon-spacing
  259.                0
  260.                ribbon-width
  261.                ribbon-spacing
  262.                ribbon-spacing
  263.                (+ ribbon-width ribbon-spacing)
  264.                ribbon-width
  265.                (+ ribbon-width ribbon-spacing)))
  266.  
  267. ; Adds a threads layer at a certain orientation to the specified image
  268.  
  269. (define (create-threads-layer img
  270.                               width
  271.                               height
  272.                               length
  273.                               density
  274.                               orientation)
  275.   (let* ((drawable (car (gimp-layer-new img width height RGBA-IMAGE
  276.                                         "Threads" 100 NORMAL-MODE)))
  277.          (dense (/ density 100.0)))
  278.     (gimp-image-add-layer img drawable -1)
  279.     (gimp-context-set-background '(255 255 255))
  280.     (gimp-edit-fill drawable BACKGROUND-FILL)
  281.     (plug-in-noisify RUN-NONINTERACTIVE img drawable FALSE dense dense dense dense)
  282.     (plug-in-c-astretch RUN-NONINTERACTIVE img drawable)
  283.     (cond ((eq? orientation 'horizontal)
  284.            (plug-in-gauss-rle RUN-NONINTERACTIVE img drawable length TRUE FALSE))
  285.           ((eq? orientation 'vertical)
  286.            (plug-in-gauss-rle RUN-NONINTERACTIVE img drawable length FALSE TRUE)))
  287.     (plug-in-c-astretch RUN-NONINTERACTIVE img drawable)
  288.     drawable))
  289.  
  290. (define (create-complete-weave width
  291.                                height
  292.                                ribbon-width
  293.                                ribbon-spacing
  294.                                shadow-darkness
  295.                                shadow-depth
  296.                                thread-length
  297.                                thread-density
  298.                                thread-intensity)
  299.   (let* ((weave (create-weave width height ribbon-width ribbon-spacing
  300.                               shadow-darkness shadow-depth))
  301.          (w-img (car weave))
  302.          (w-layer (cadr weave))
  303.  
  304.          (h-layer (create-threads-layer w-img width height thread-length
  305.                                         thread-density 'horizontal))
  306.          (h-mask (car (gimp-layer-create-mask h-layer ADD-WHITE-MASK)))
  307.  
  308.          (v-layer (create-threads-layer w-img width height thread-length
  309.                                         thread-density 'vertical))
  310.          (v-mask (car (gimp-layer-create-mask v-layer ADD-WHITE-MASK)))
  311.  
  312.          (hmask (create-horizontal-mask ribbon-width ribbon-spacing
  313.                                         width height))
  314.          (hm-img (car hmask))
  315.          (hm-layer (cadr hmask))
  316.  
  317.          (vmask (create-vertical-mask ribbon-width ribbon-spacing width height))
  318.          (vm-img (car vmask))
  319.          (vm-layer (cadr vmask)))
  320.  
  321.     (gimp-layer-add-mask h-layer h-mask)
  322.     (gimp-selection-all hm-img)
  323.     (gimp-edit-copy hm-layer)
  324.     (gimp-image-delete hm-img)
  325.     (gimp-floating-sel-anchor (car (gimp-edit-paste h-mask FALSE)))
  326.     (gimp-layer-set-opacity h-layer thread-intensity)
  327.     (gimp-layer-set-mode h-layer MULTIPLY-MODE)
  328.  
  329.     (gimp-layer-add-mask v-layer v-mask)
  330.     (gimp-selection-all vm-img)
  331.     (gimp-edit-copy vm-layer)
  332.     (gimp-image-delete vm-img)
  333.     (gimp-floating-sel-anchor (car (gimp-edit-paste v-mask FALSE)))
  334.     (gimp-layer-set-opacity v-layer thread-intensity)
  335.     (gimp-layer-set-mode v-layer MULTIPLY-MODE)
  336.  
  337.     ; Uncomment this if you want to keep the weaving mask image
  338.     ; (gimp-display-new (car (gimp-image-duplicate w-img)))
  339.  
  340.     (list w-img
  341.           (car (gimp-image-flatten w-img)))))
  342.  
  343. ; The main weave function
  344.  
  345. (define (script-fu-weave img
  346.                          drawable
  347.                          ribbon-width
  348.                          ribbon-spacing
  349.                          shadow-darkness
  350.                          shadow-depth
  351.                          thread-length
  352.                          thread-density
  353.                          thread-intensity)
  354.   (let* (
  355.         (d-img (car (gimp-drawable-get-image drawable)))
  356.         (d-width (car (gimp-drawable-width drawable)))
  357.         (d-height (car (gimp-drawable-height drawable)))
  358.         (d-offsets (gimp-drawable-offsets drawable))
  359.  
  360.         (weaving (create-complete-weave d-width
  361.                                         d-height
  362.                                         ribbon-width
  363.                                         ribbon-spacing
  364.                                         shadow-darkness
  365.                                         shadow-depth
  366.                                         thread-length
  367.                                         thread-density
  368.                                         thread-intensity))
  369.         (w-img (car weaving))
  370.         (w-layer (cadr weaving))
  371.         )
  372.  
  373.     (gimp-context-push)
  374.  
  375.     (gimp-selection-all w-img)
  376.     (gimp-edit-copy w-layer)
  377.     (gimp-image-delete w-img)
  378.     (let ((floating-sel (car (gimp-edit-paste drawable FALSE))))
  379.       (gimp-layer-set-offsets floating-sel
  380.                               (car d-offsets)
  381.                               (cadr d-offsets))
  382.       (gimp-layer-set-mode floating-sel MULTIPLY-MODE)
  383.       (gimp-floating-sel-to-layer floating-sel)
  384.     )
  385.  
  386.     (gimp-displays-flush)
  387.  
  388.     (gimp-context-pop)
  389.   )
  390. )
  391.  
  392. (script-fu-register "script-fu-weave"
  393.   _"_Weave..."
  394.   _"Create a new layer filled with a weave effect to be used as an overlay or bump map"
  395.   "Federico Mena Quintero"
  396.   "Federico Mena Quintero"
  397.   "June 1997"
  398.   "RGB* GRAY*"
  399.   SF-IMAGE       "Image to Weave"    0
  400.   SF-DRAWABLE    "Drawable to Weave" 0
  401.   SF-ADJUSTMENT _"Ribbon width"     '(30  0 256 1 10 1 1)
  402.   SF-ADJUSTMENT _"Ribbon spacing"   '(10  0 256 1 10 1 1)
  403.   SF-ADJUSTMENT _"Shadow darkness"  '(75  0 100 1 10 1 1)
  404.   SF-ADJUSTMENT _"Shadow depth"     '(75  0 100 1 10 1 1)
  405.   SF-ADJUSTMENT _"Thread length"    '(200 0 256 1 10 1 1)
  406.   SF-ADJUSTMENT _"Thread density"   '(50  0 100 1 10 1 1)
  407.   SF-ADJUSTMENT _"Thread intensity" '(100 0 100 1 10 1 1)
  408. )
  409.  
  410. (script-fu-menu-register "script-fu-weave"
  411.                          "<Image>/Filters/Artistic")
  412.